home *** CD-ROM | disk | FTP | other *** search
/ Computer Select (Limited Edition) / Computer Select.iso / pcmag / v10n16 / calc.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1991-06-26  |  7.5 KB  |  288 lines
  1. {$A+,B-,D-,E-,F+,G-,I+,L-,N-,O+,R-,S-,V-,X-}
  2. UNIT Calc;
  3. (**) INTERFACE (**)
  4.   FUNCTION add(A, B : String) : String;
  5.   FUNCTION sub(A, B : String) : String;
  6.   FUNCTION prod(A, B : String) : String;
  7.   FUNCTION divide(A, B : String; VAR Rm : String):String;
  8.   FUNCTION fact(VAR A : String) : String;
  9.   FUNCTION power(B, E : String) : String;
  10. (**) IMPLEMENTATION (**)
  11.   FUNCTION SubChar(C1, C2 : Char; VAR borrow : Boolean)
  12.              : Char; Assembler;
  13.   {Subtracts one digit char ('0' thru '9') from
  14.    another and returns the result as a digit.  Sets
  15.    borrow to true if appropriate.}
  16.   ASM
  17.     LES DI, Borrow
  18.     MOV Byte Ptr ES:[DI], FALSE
  19.     MOV AL, C1
  20.     SUB AL, C2
  21.     JGE @NoBorrow
  22.     MOV Byte Ptr ES:[DI], TRUE
  23.     ADD AL, 10
  24.     @NoBorrow:
  25.     ADD AL, 30h
  26.   END;
  27.  
  28.   FUNCTION AddChar(C1, C2 : Char; VAR carry : Boolean)
  29.              : Char; Assembler;
  30.   {Adds one digit char ('0' thru '9') to
  31.    another and returns the result as a digit.
  32.    Sets carry to true if appropriate.}
  33.   ASM
  34.     LES DI, Carry
  35.     MOV Byte Ptr ES:[DI], FALSE
  36.     MOV AL, C1
  37.     ADD AL, C2
  38.     SUB AL, 60h {30h for each digit}
  39.     CMP AL, 10
  40.     JL @NoCarry
  41.     SUB AL, 10
  42.     MOV Byte Ptr ES:[DI], TRUE
  43.     @NoCarry:
  44.     ADD AL, 30h
  45.   END;
  46.  
  47.   FUNCTION LeftPad0(S : String; Len : Byte) : String;
  48.   BEGIN
  49.     IF length(S) < Len THEN
  50.       BEGIN
  51.         MOVE(S[1], S[succ(Len - length(S))], length(S));
  52.         FillChar(S[1], Len - length(S), '0');
  53.       END;
  54.     S[0] := Char(Len);
  55.     LeftPad0 := S;
  56.   END;
  57.  
  58.   PROCEDURE TrimLead0(VAR S : String);
  59.   VAR P : Byte;
  60.   BEGIN
  61.     P := 1;
  62.     WHILE (S[P] = '0') AND (P <= length(S)) DO Inc(P);
  63.     CASE P OF
  64.       0 : S[0] := #0; {string was 255 of '0'!}
  65.       1 : ; {not found}
  66.       ELSE
  67.         Move(S[P], S[1], succ(length(S) - P));
  68.         Dec(S[0], pred(P));
  69.     END;
  70.   END;
  71.  
  72.   FUNCTION add(A, B : String) : String;
  73.   VAR T     : String;
  74.       psn   : Word;
  75.       Len   : Byte;
  76.       carry : Boolean;
  77.   BEGIN
  78.     add[0] := #0;
  79.     IF (Length(A) >= 254) THEN Exit;
  80.     IF (Length(B) >= 254) THEN Exit;
  81.     IF A[0] = #0 THEN Exit;
  82.     IF B[0] = #0 THEN Exit;
  83.     carry := False;
  84.     IF Length(A) > Length(B) THEN Len := Succ(Length(A))
  85.     ELSE Len := Succ(Length(B));
  86.     A     := LeftPad0(A, Len);
  87.     B     := LeftPad0(B, Len);
  88.     FillChar(T[1], Len, '0');
  89.     T[0] := Char(Len);
  90.     psn  := Succ(Len);
  91.     {add digits from right to left}
  92.     WHILE psn > 1 DO
  93.       BEGIN
  94.         Dec(psn);
  95.         IF carry THEN
  96.           T[psn] := AddChar(Succ(A[psn]), B[psn], carry)
  97.         ELSE T[psn] := AddChar(A[psn], B[psn], carry);
  98.       END;
  99.     IF carry THEN T[1] := '1';
  100.     TrimLead0(T);
  101.     IF T = '' THEN T := '0';
  102.     add := T;
  103.   END;
  104.  
  105.   FUNCTION Compare(X, Y : String) : ShortInt;
  106.   {Returns -1 if X < Y, 0 if equal, 1 if X > Y}
  107.   BEGIN
  108.     TrimLead0(X);  { cut off any leading zeroes }
  109.     TrimLead0(Y);
  110.     IF Length(X) = Length(Y) THEN
  111.       BEGIN
  112.         IF X = Y THEN Compare := 0
  113.         ELSE IF X > Y THEN Compare := 1
  114.         ELSE Compare := -1;
  115.       END
  116.     ELSE IF Length(X) > Length(Y) THEN Compare := 1
  117.     ELSE Compare := -1;
  118.   END;
  119.  
  120.   FUNCTION sub(A, B : String) : String;
  121.   VAR T             : String;
  122.       psn, Len      : Word;
  123.       borrow, minus : Boolean;
  124.   BEGIN
  125.     sub[0] := #0;
  126.     IF (Length(A) >= 254) THEN Exit;
  127.     IF (Length(B) >= 254) THEN Exit;
  128.     IF A[0] = #0 THEN Exit;
  129.     IF B[0] = #0 THEN Exit;
  130.     borrow := False;
  131.     minus  := False;
  132.     {subtract smaller from larger}
  133.     IF Compare(A, B) = -1 THEN
  134.       BEGIN
  135.         minus := True;
  136.         T := A; A := B; B := T;
  137.       END;
  138.     IF Length(A) > Length(B) THEN Len := Succ(Length(A))
  139.     ELSE Len := Succ(Length(B));
  140.     A    := LeftPad0(A, Len);
  141.     B    := LeftPad0(B, Len);
  142.     FillChar(T[1], Len, '0');
  143.     T[0] := Char(Len);
  144.     psn := Succ(Len);
  145.     {subtract digits from right to left}
  146.     WHILE psn > 1 DO
  147.       BEGIN
  148.         Dec(psn);
  149.         IF borrow THEN
  150.           T[psn] := subChar(Pred(A[psn]), B[psn], borrow)
  151.         ELSE T[psn] := subChar(A[psn], B[psn], borrow);
  152.       END;
  153.     TrimLead0(T);
  154.     IF T = '' THEN T := '0';
  155.     IF minus THEN
  156.       BEGIN
  157.         Move(T[1], T[2], length(T));
  158.         T[1] := '-';
  159.         Inc(T[0]);
  160.       END;
  161.     sub := T;
  162.   END;
  163.  
  164.   FUNCTION prod(A, B : String) : String;
  165.   VAR T1, T2         : String;
  166.       posn, times, N : Word;
  167.   BEGIN
  168.     prod[0] := #0;
  169.     IF (Length(A) + Length(B) > 254) THEN Exit;
  170.     IF A[0] = #0 THEN Exit;
  171.     IF B[0] = #0 THEN Exit;
  172.     {multiply larger by smaller}
  173.     IF Compare(A, B) = -1 THEN
  174.       BEGIN
  175.         T1 := A; A := B; B := T1;
  176.       END;
  177.     T2 := '0';
  178.     {for each digit of multiplier, right to left,
  179.      add together an appropriate number of copies
  180.      of multiplicand, tack the right number of
  181.      zeroes on the end, and add the result to the
  182.      running total in T2}
  183.     FOR posn := Length(B) DOWNTO 1 DO
  184.       BEGIN
  185.         times := Ord(B[posn])-48;
  186.         IF times = 0 THEN T1 := '0'
  187.         ELSE
  188.           BEGIN
  189.             T1 := A;
  190.             FOR N := 2 to times DO
  191.               T1 := add(T1, A);
  192.           END;
  193.         FillChar(T1[succ(length(T1))],
  194.                  length(B)-posn, '0');
  195.         Inc(T1[0], length(B)-posn);
  196.         T2 := add(T2, T1);
  197.       END;
  198.     prod := T2;
  199.   END;
  200.  
  201.   FUNCTION divide(A, B : String; VAR Rm : String):String;
  202.   VAR T1, T2, T3 : String;
  203.   BEGIN
  204.     divide[0]    := #0;
  205.     Rm[0] := #0;
  206.     IF A[0] = #0 THEN Exit;
  207.     IF B[0] = #0 THEN Exit;
  208.     IF Compare(B, '0') = 0 THEN Exit;
  209.     IF Compare(A, B) = 0 THEN
  210.       BEGIN
  211.         divide    := '1';
  212.         Rm := '0';
  213.       END
  214.     ELSE
  215.       BEGIN
  216.         T1 := B; T2 := '1'; T3 := '0';
  217.         {While dividend is > T1, add zeroes to
  218.          T1 and to T2}
  219.         WHILE Compare(A, T1) = 1 DO
  220.           BEGIN
  221.             Inc(T1[0]); T1[length(T1)] := '0';
  222.             Inc(T2[0]); T2[length(T2)] := '0';
  223.           END;
  224.         {get individual digits of quotient by
  225.          repeated subtraction of T1.  T1 is the
  226.          divisor with a steadily decreasing number
  227.          of zeroes after it.}
  228.         WHILE Compare(T1, B) <> 0 DO
  229.           BEGIN
  230.             Dec(T1[0]);
  231.             Dec(T2[0]);
  232.             WHILE Compare(A, T1) <> -1 DO
  233.               BEGIN
  234.                 A := sub(A, T1);
  235.                 IF A[0] = #0 THEN Exit;
  236.                 T3 := add(T3, T2);
  237.                 IF T3[0] = #0 THEN Exit;
  238.               END;
  239.           END;
  240.         divide := T3;
  241.         Rm := A;
  242.         TrimLead0(Rm);
  243.         IF Rm = '' THEN Rm := '0';
  244.       END;
  245.   END;
  246.  
  247.   FUNCTION fact(VAR A : String) : String;
  248.   VAR T1, T2 : String;
  249.   BEGIN
  250.     T1 := '1';
  251.     T2 := '1';
  252.     IF (A <> '1') AND (A <> '0') THEN
  253.       WHILE (T2 <> A) AND (T1[0] <> #0) DO
  254.         BEGIN
  255.           T2 := add(T2, '1');
  256.           T1 := prod(T1, T2);
  257.         END;
  258.     fact := T1;
  259.   END;
  260.  
  261.   FUNCTION power(B, E : String) : String;
  262.   VAR T1, T2, T3, Rem : String;
  263.   BEGIN
  264.     power[0] := #0;
  265.     IF B[0] = #0 THEN Exit;
  266.     IF E[0] = #0 THEN Exit;
  267.     power := '0';
  268.     IF B = '0' THEN Exit;
  269.     power := '1';
  270.     IF E = '0' THEN Exit;
  271.     T1 := B;
  272.     T2 := E;
  273.     T3 := '1';
  274.     {calculate power by halving and squaring}
  275.     WHILE (T2 <> '0') AND (T3[0] <> #0) DO
  276.       BEGIN
  277.         {halve the exponent}
  278.         T2 := divide(T2, '2', rem);
  279.         {if it was odd, multiply T3 by current
  280.          value of T1}
  281.         IF rem = '1' THEN
  282.           T3 := prod(T3, T1);
  283.         {square T1}
  284.         T1 := prod(T1, T1);
  285.       END;
  286.     power := T3;
  287.   END;
  288. END.